home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD School House 10
/
CD School House - Education and Games (10.0) - Wayzata Technology (1995).iso
/
mac
/
DOS
/
MISC
/
ESPTEST
/
ESPSCORE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-20
|
20KB
|
586 lines
{$R+}
{$U+}
{**********************************************************}
{** **}
{** ESPSCORE **}
{** **}
{** A unit that saves scores: **}
{** in a series of records that represent a total **}
{** record of time, date, elapsed time, color of **}
{** the screen, type of sound reinforcement, type **}
{** of visual reinforcement, the placement of the **}
{** target on the select menu, the target and the **}
{** current name of the saved file. **}
{** **}
{** Copyright 1991 Phil Mosier **}
{** **}
{**********************************************************}
Unit ESPSCORE;
{****}
Interface
Uses Graph,Crt;
Procedure SAVESCORE(Var WRITE_OK : Boolean;
D_TARGET:Char;
D_GUESS:Char;
D_HIT_MISS:Char;
D_COLOR_OF_CARD:Char;
D_SCREEN_DISPLAY1:Char;
D_SCREEN_DISPLAY2:Char;
D_SCREEN_DISPLAY3:Char;
D_SCREEN_DISPLAY4:Char;
D_SCREEN_DISPLAY5:Char;
D_REINFORCE_SOUND:Char;
D_REINFORCE_VISUAL:Char;
D_STYLE:Char;
D_CUR_YEAR:Word;
D_CUR_MONTH:Word;
D_CUR_DAY:Word;
D_START_HOUR:Word;
D_START_MIN:Word;
D_START_SEC:Word;
D_ELAPESED_SEC:LongInt;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
Procedure GETSCORE (Var HITS:Word;
Var TRIALS :Word;
Var FOUND_FLAG : Boolean;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
Procedure GET_RATIOS(Var HIT_I_1: Word;
Var HIT_I_2: Word;
Var HIT_I_3: Word;
Var HIT_I_4: Word;
Var HIT_I_5: Word;
Var HIT_P_1: Word;
Var HIT_P_2: Word;
Var HIT_P_3: Word;
Var HIT_P_4: Word;
Var HIT_P_5: Word;
Var TRIAL_I_1: Word;
Var TRIAL_I_2: Word;
Var TRIAL_I_3: Word;
Var TRIAL_I_4: Word;
Var TRIAL_I_5: Word;
Var TRIAL_P_1: Word;
Var TRIAL_P_2: Word;
Var TRIAL_P_3: Word;
Var TRIAL_P_4: Word;
Var TRIAL_P_5: Word;
Var TIME_SHORT_HIT: Word;
Var TIME_LONG_HIT: Word;
Var TIME_SHORT_TRIAL: Word;
Var TIME_LONG_TRIAL: Word;
Var FOUND_FLAG : Boolean;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
Implementation
Procedure SAVESCORE(Var WRITE_OK: Boolean;
D_TARGET:Char;
D_GUESS:Char;
D_HIT_MISS:Char;
D_COLOR_OF_CARD:Char;
D_SCREEN_DISPLAY1:Char;
D_SCREEN_DISPLAY2:Char;
D_SCREEN_DISPLAY3:Char;
D_SCREEN_DISPLAY4:Char;
D_SCREEN_DISPLAY5:Char;
D_REINFORCE_SOUND:Char;
D_REINFORCE_VISUAL:Char;
D_STYLE:Char;
D_CUR_YEAR:Word;
D_CUR_MONTH:Word;
D_CUR_DAY:Word;
D_START_HOUR:Word;
D_START_MIN:Word;
D_START_SEC:Word;
D_ELAPESED_SEC:LongInt;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
{*********************************************************}
{** **}
{** SAVE SCORE **}
{** **}
{*********************************************************}
Var GUESS_FILE : Text;
DAT_GUESS_RECORD : Array[1..43] Of Char;
DATE_TEMP : String[10];
TIME_TEMP : String[8];
ELAPESED_SEC_TEMP : String[5];
INDEX : Byte;
YEAR_ST4 : String[4];
MONTH_ST2 : String[2];
DAY_ST2 : String[2];
HOUR_ST2 : String[2];
MIN_ST2 : String[2];
SEC_ST2 : String[2];
IOCODE : Word;
OKAY_FLAG : Boolean;
GUESS_FILE_NAME : String[12];
TEMP_FILE_NAME : String[8];
TEST : STRING[4];
Begin
DAT_GUESS_RECORD[1] := D_TARGET;
DAT_GUESS_RECORD[2] := D_GUESS;
DAT_GUESS_RECORD[3] := D_HIT_MISS;
DAT_GUESS_RECORD[4] := D_COLOR_OF_CARD;
DAT_GUESS_RECORD[5] := D_SCREEN_DISPLAY1;
DAT_GUESS_RECORD[6] := D_SCREEN_DISPLAY2;
DAT_GUESS_RECORD[7] := D_SCREEN_DISPLAY3;
DAT_GUESS_RECORD[8] := D_SCREEN_DISPLAY4;
DAT_GUESS_RECORD[9] := D_SCREEN_DISPLAY5;
DAT_GUESS_RECORD[10] := D_REINFORCE_SOUND;
DAT_GUESS_RECORD[11] := D_REINFORCE_VISUAL;
DAT_GUESS_RECORD[12] := D_STYLE;
Str(D_CUR_YEAR:4,YEAR_ST4);
Str(D_CUR_MONTH:2,MONTH_ST2);
Str(D_CUR_DAY:2,DAY_ST2);
DATE_TEMP := YEAR_ST4+'-'+MONTH_ST2+'-'+DAY_ST2;
For INDEX := 1 To 10 Do
DAT_GUESS_RECORD[12 + INDEX] := DATE_TEMP[INDEX];
Str(D_START_HOUR:2,HOUR_ST2);
Str(D_START_MIN:2,MIN_ST2);
Str(D_START_SEC:2,SEC_ST2);
TIME_TEMP := HOUR_ST2+':'+MIN_ST2+':'+SEC_ST2;
For INDEX :=1 To 8 Do
DAT_GUESS_RECORD[22 + INDEX] := TIME_TEMP[INDEX];
Str(D_ELAPESED_SEC:5,ELAPESED_SEC_TEMP);
For INDEX := 1 To 5 Do
DAT_GUESS_RECORD[30 + INDEX] := ELAPESED_SEC_TEMP[INDEX];
DAT_GUESS_RECORD[36] := D_NAME1;
DAT_GUESS_RECORD[37] := D_NAME2;
DAT_GUESS_RECORD[38] := D_NAME3;
DAT_GUESS_RECORD[39] := D_NAME4;
DAT_GUESS_RECORD[40] := D_NAME5;
DAT_GUESS_RECORD[41] := D_NAME6;
DAT_GUESS_RECORD[42] := D_NAME7;
DAT_GUESS_RECORD[43] := D_NAME8;
For INDEX := 36 To 43 Do
Begin
If DAT_GUESS_RECORD[INDEX] <> ' ' Then
Begin
TEMP_FILE_NAME[INDEX - 35] := DAT_GUESS_RECORD[INDEX];
TEMP_FILE_NAME[0] := Char(INDEX - 35);
End { End Of DAT_GUESS_RECORD[INDEX] <> ' ' }
End; { End Of For INDEX 36 To 43 }
GUESS_FILE_NAME := TEMP_FILE_NAME+'.ESP';
{************************************************}
{** **}
{** This set of lines could print file **}
{** instead of writing them to a file **}
{** **}
{** ASSIGN (GUESS_FILE,'PRN'); **}
{** RESET (GUESS_FILE); **}
{** WRITELN(GUESS_FILE,DAT_GUESS_RECORD); **}
{************************************************}
WRITE_OK := True;
Assign(GUESS_FILE,GUESS_FILE_NAME);
{$I-}
RESET(GUESS_FILE);
IOCODE := IOResult;
{$I+}
If IOCODE <> 0 Then
Begin
If IOCODE = 2 Then
Begin
{$I-}
ReWrite(GUESS_FILE);
{$I+}
IOCODE := IOResult;
If IOCODE = 0 Then
Begin
WriteLn(GUESS_FILE,DAT_GUESS_RECORD);
Close(GUESS_FILE)
End
Else
Begin
WRITE_OK := False;
ClearDevice;
MoveTo(0,190);
OutText(' Disk Problems !');
Sound(440);
Delay(1000);
NoSound
End { If IOCODE <> 0 }
End {If IOCODE = 2}
Else
Begin
WRITE_OK := False;
ClearDevice;
MoveTo(0,190);
OutText(' Disk Problems !');
Sound(440);
Delay(1000);
NoSound
End { IOCODE <> 2}
End
Else
Begin
APPEND(GUESS_FILE);
WriteLn(GUESS_FILE, DAT_GUESS_RECORD);
Close(GUESS_FILE)
End {** If IOCODE = 0 **}
End; { End of SAVESCORE }
Procedure GETSCORE (Var HITS: Word;
Var TRIALS: Word;
Var FOUND_FLAG :Boolean;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
{**************************************}
{** **}
{**************************************}
Var STRING8: String[9];
FILE_NAME: String[12];
DAT_GUESS_RECORD: String[43];
INDEX: Byte;
GUESS_FILE: Text;
IOCODE: Word;
TEMP:String[17];
Begin
FOUND_FLAG := True;
HITS := 0;
TRIALS := 0;
For INDEX := 1 To 43 Do
DAT_GUESS_RECORD[INDEX] := ' ';
STRING8[1] := D_NAME1;
STRING8[2] := D_NAME2;
STRING8[3] := D_NAME3;
STRING8[4] := D_NAME4;
STRING8[5] := D_NAME5;
STRING8[6] := D_NAME6;
STRING8[7] := D_NAME7;
STRING8[8] := D_NAME8;
INDEX := 1;
Repeat
STRING8[0] := Char(INDEX);
INDEX := INDEX + 1;
Until ((STRING8[INDEX] = ' ') Or (INDEX > 8));
FILE_NAME := STRING8+'.ESP';
Assign(GUESS_FILE,FILE_NAME);
{$I-}
Reset(GUESS_FILE);
{$I+}
IOCODE := IOResult;
If IOCODE <> 0 Then
If IOCODE = 2 Then
Begin
ClearDevice;
MoveTo(0,80);
OutText(FILE_NAME);
MoveTo(0,120);
OutText('File not found');
Delay(4000);
FOUND_FLAG := False;
End { End If iocode = 2 }
Else
Begin
ClearDevice;
MoveTo(0,190);
OutText(' Disk Problems !');
Sound(440);
Delay(1000);
NoSound;
Halt(0);
End
Else
Begin { If IOCODE = 0 }
While Not Eof(GUESS_FILE) Do
Begin
ReadLn(GUESS_FILE,DAT_GUESS_RECORD);
If DAT_GUESS_RECORD[3] = 'H' Then
HITS := HITS + 1;
TRIALS := TRIALS + 1;
End; { While Not EOF }
Close(GUESS_FILE);
End; { If IOCODE = 0 }
End; { End of GETSCORE }
Procedure GET_RATIOS(Var HIT_I_1: Word;
Var HIT_I_2: Word;
Var HIT_I_3: Word;
Var HIT_I_4: Word;
Var HIT_I_5: Word;
Var HIT_P_1: Word;
Var HIT_P_2: Word;
Var HIT_P_3: Word;
Var HIT_P_4: Word;
Var HIT_P_5: Word;
Var TRIAL_I_1: Word;
Var TRIAL_I_2: Word;
Var TRIAL_I_3: Word;
Var TRIAL_I_4: Word;
Var TRIAL_I_5: Word;
Var TRIAL_P_1: Word;
Var TRIAL_P_2: Word;
Var TRIAL_P_3: Word;
Var TRIAL_P_4: Word;
Var TRIAL_P_5: Word;
Var TIME_SHORT_HIT: Word;
Var TIME_LONG_HIT: Word;
Var TIME_SHORT_TRIAL: Word;
Var TIME_LONG_TRIAL: Word;
Var FOUND_FLAG : Boolean;
D_NAME1: Char;
D_NAME2: Char;
D_NAME3: Char;
D_NAME4: Char;
D_NAME5: Char;
D_NAME6: Char;
D_NAME7: Char;
D_NAME8: Char);
{**************************************}
{** **}
{**************************************}
Var STRING5: String[5];
STRING8: String[9];
FILE_NAME: String[12];
DAT_GUESS_RECORD: String[43];
INDEX: Byte;
STRING_INDEX: Word;
GUESS_FILE: Text;
IOCode: Word;
THIS_ELAPSED_SEC : Real;
TOTAL_SEC : Real;
CODE : Integer;
REC_COUNT : Word;
AVER_SEC : Real;
Begin
FOUND_FLAG := True;
HIT_I_1:= 0;
HIT_I_2:= 0;
HIT_I_3:= 0;
HIT_I_4:= 0;
HIT_I_5:= 0;
HIT_P_1:= 0;
HIT_P_2:= 0;
HIT_P_3:= 0;
HIT_P_4:= 0;
HIT_P_5:= 0;
TRIAL_I_1:= 0;
TRIAL_I_2:= 0;
TRIAL_I_3:= 0;
TRIAL_I_4:= 0;
TRIAL_I_5:= 0;
TRIAL_P_1:= 0;
TRIAL_P_2:= 0;
TRIAL_P_3:= 0;
TRIAL_P_4:= 0;
TRIAL_P_5:= 0;
TOTAL_SEC := 0;
TIME_SHORT_HIT:= 0;
TIME_LONG_HIT:= 0;
TIME_SHORT_TRIAL:= 0;
TIME_LONG_TRIAL:= 0;
REC_COUNT := 0;
For INDEX := 1 To 43 Do
DAT_GUESS_RECORD[INDEX] := ' ';
STRING8[1] := D_NAME1;
STRING8[2] := D_NAME2;
STRING8[3] := D_NAME3;
STRING8[4] := D_NAME4;
STRING8[5] := D_NAME5;
STRING8[6] := D_NAME6;
STRING8[7] := D_NAME7;
STRING8[8] := D_NAME8;
INDEX := 1;
Repeat
STRING8[0] := Char(INDEX);
INDEX := INDEX + 1;
Until ((STRING8[INDEX] = ' ') Or (INDEX > 8));
FILE_NAME := STRING8+'.ESP';
Assign(GUESS_FILE,FILE_NAME);
{$I-}
Reset(GUESS_FILE);
{$I+}
IOCODE := IOResult;
If IOCODE <> 0 Then
If IOCODE = 2 Then
Begin
ClearDevice;
MoveTo(0,80);
OutText(FILE_NAME);
MoveTo(0,90);
OutText('File not found');
Delay(4000);
FOUND_FLAG := False;
End { End If IOCode = 2 }
Else
Begin
ClearDevice;
MoveTo(0,80);
OutText('Disk problems!');
MoveTo(0,100);
OutText(STRING5);
Delay(4000);
FOUND_FLAG := False;
Halt(0);
End
Else
Begin
While Not Eof(GUESS_FILE) Do
Begin
ReadLn(GUESS_FILE,DAT_GUESS_RECORD);
{*********************************************************}
{** DAT_GUESS_RECORD[1] -- Target **}
{** DAT_GUESS_RECORD[3] -- Hit/Miss **}
{*********************************************************}
If ((DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[1]) - 44] = '1') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_I_1 := HIT_I_1 + 1;
If ((DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[1]) - 44] = '2') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_I_2 := HIT_I_2 + 1;
If ((DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[1]) - 44] = '3') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_I_3 := HIT_I_3 + 1;
If ((DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[1]) - 44] = '4') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_I_4 := HIT_I_4 + 1;
If ((DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[1]) - 44] = '5') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_I_5 := HIT_I_5 + 1;
{*********************************************************}
{** DAT_GUESS_RECORD[2] -- Place you choose **}
{** DAT_GUESS_RECORD[3] -- Hit/Miss **}
{*********************************************************}
If ((DAT_GUESS_RECORD[2] = '1') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_P_1 := HIT_P_1 + 1;
If ((DAT_GUESS_RECORD[2] = '2') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_P_2 := HIT_P_2 + 1;
If ((DAT_GUESS_RECORD[2] = '3') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_P_3 := HIT_P_3 + 1;
If ((DAT_GUESS_RECORD[2] = '4') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_P_4 := HIT_P_4 + 1;
If ((DAT_GUESS_RECORD[2] = '5') And
(DAT_GUESS_RECORD[3] = 'H')) Then
HIT_P_5 := HIT_P_5 + 1;
{*********************************************************}
{** DAT_GUESS_RECORD[2] -- Place you choose **}
{** DAT_GUESS_RECORD[Ord( " ) - 44] **}
{** -- Image you choose **}
{*********************************************************}
If DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[2]) - 44]
= '1' Then TRIAL_I_1 := TRIAL_I_1 + 1;
If DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[2]) - 44]
= '2' Then TRIAL_I_2 := TRIAL_I_2 + 1;
If DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[2]) - 44]
= '3' Then TRIAL_I_3 := TRIAL_I_3 + 1;
If DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[2]) - 44]
= '4' Then TRIAL_I_4 := TRIAL_I_4 + 1;
If DAT_GUESS_RECORD[Ord(DAT_GUESS_RECORD[2]) - 44]
= '5' Then TRIAL_I_5 := TRIAL_I_5 + 1;
{*********************************************************}
{** DAT_GUESS_RECORD[2] -- Place you choose **}
{*********************************************************}
If DAT_GUESS_RECORD[2] = '1' Then
TRIAL_P_1 := TRIAL_P_1 + 1;
If DAT_GUESS_RECORD[2] = '2' Then
TRIAL_P_2 := TRIAL_P_2 + 1;
If DAT_GUESS_RECORD[2] = '3' Then
TRIAL_P_3 := TRIAL_P_3 + 1;
If DAT_GUESS_RECORD[2] = '4' Then
TRIAL_P_4 := TRIAL_P_4 + 1;
If DAT_GUESS_RECORD[2] = '5' Then
TRIAL_P_5 := TRIAL_P_5 + 1;
STRING_INDEX :=0;
For INDEX := 1 To 5 Do
Begin
If DAT_GUESS_RECORD[30 + INDEX] <> ' ' Then
Begin
STRING_INDEX := STRING_INDEX + 1;
STRING5[STRING_INDEX] := DAT_GUESS_RECORD[30 + INDEX];
End
End;
STRING5[0] := Char(STRING_INDEX);
Val(STRING5,THIS_ELAPSED_SEC,CODE);
TOTAL_SEC := TOTAL_SEC + THIS_ELAPSED_SEC;
REC_COUNT := REC_COUNT + 1;
AVER_SEC := TOTAL_SEC / REC_COUNT;
AVER_SEC := AVER_SEC / 2;
End; { while not eof }
Assign(GUESS_FILE,FILE_NAME);
Reset(GUESS_FILE);
While Not Eof(GUESS_FILE) Do
Begin
ReadLn(GUESS_FILE,DAT_GUESS_RECORD);
STRING_INDEX :=0;
For INDEX := 1 To 5 Do
Begin
If DAT_GUESS_RECORD[30 + INDEX] <> ' ' Then
Begin
STRING_INDEX := STRING_INDEX + 1;
STRING5[STRING_INDEX] := DAT_GUESS_RECORD[30 + INDEX];
End
End;
STRING5[0] := Char(STRING_INDEX);
Val(STRING5,THIS_ELAPSED_SEC,CODE);
If ((DAT_GUESS_RECORD[3] = 'H') And
(AVER_SEC >= THIS_ELAPSED_SEC)) Then
TIME_SHORT_HIT := TIME_SHORT_HIT + 1;
If (AVER_SEC >= THIS_ELAPSED_SEC) Then
TIME_SHORT_TRIAL := TIME_SHORT_TRIAL + 1;
If ((DAT_GUESS_RECORD[3] = 'H') And
(AVER_SEC < THIS_ELAPSED_SEC)) Then
TIME_LONG_HIT := TIME_LONG_HIT + 1;
If (AVER_SEC < THIS_ELAPSED_SEC) Then
TIME_LONG_TRIAL := TIME_LONG_TRIAL + 1;
End; { while not EOF }
End; { IOCODE = 0 }
Close(GUESS_FILE);
End; { End of GET_RATIOS }
End. { End of ESPSCORE }